home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / COMMON / TOOLS / VB / UNSUPPRT / SSAVER / SSAVER.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-01-16  |  8.9 KB  |  169 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSSaver 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "VB 5 - Screen Saver"
  5.    ClientHeight    =   2790
  6.    ClientLeft      =   2460
  7.    ClientTop       =   1935
  8.    ClientWidth     =   4440
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    Icon            =   "SSaver.frx":0000
  12.    KeyPreview      =   -1  'True
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    Moveable        =   0   'False
  17.    NegotiateMenus  =   0   'False
  18.    ScaleHeight     =   186
  19.    ScaleMode       =   3  'Pixel
  20.    ScaleWidth      =   296
  21.    ShowInTaskbar   =   0   'False
  22.    WindowState     =   2  'Maximized
  23.    Begin VB.Timer ssTimer 
  24.       Interval        =   50
  25.       Left            =   3930
  26.       Top             =   2250
  27.    End
  28. Attribute VB_Name = "frmSSaver"
  29. Attribute VB_GlobalNameSpace = False
  30. Attribute VB_Creatable = False
  31. Attribute VB_PredeclaredId = True
  32. Attribute VB_Exposed = False
  33. Option Explicit
  34. '-----------------------------------------------------------------
  35. ' Declare Variables and Constants
  36. '-----------------------------------------------------------------
  37. Private ssEng As ssEngine                   ' Sprite builder engine
  38. '''Private Sprite() As ssSprite                ' Array of active sprites...
  39. Const BMPXUNITS = 1                         ' # sprite frames on the x axis
  40. Const BMPYUNITS = 46                        ' # sprite frames on the y axis
  41. Const IDB_BITMAP = 101                      ' Res File bitmap image ID
  42. '-----------------------------------------------------------------
  43. Private Sub Form_Load()
  44. '-----------------------------------------------------------------
  45.     Dim Idx As Long                         ' Loop index
  46.     Dim ScaleSize As Single                 ' New sprite size (relative to resource size)
  47. '-----------------------------------------------------------------
  48.     InitDeskDC DeskDC, DeskBmp, DispRec     ' Initialize desktop image information...
  49.     LoadSettings                            ' Load saver registry settings...
  50. #If Not DebugOn Then                        ' Don't do if debugging...
  51.     ' Subclass windproc...(not currently used)
  52. '   PrevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubWndProc)
  53. #End If
  54.     Set ssEng = New ssEngine                    ' Create new Sprite builder engine
  55.     ReDim gSSprite(gSpriteCount - 1) As ssSprite ' Resize active sprite array...
  56.     For Idx = LBound(gSSprite) To UBound(gSSprite)  ' Initialize each sprite...
  57.         If gSizeRND Then                          ' Determine if sprite size is random...
  58.             ' Randomize sprite size...
  59.             ScaleSize = (((MAX_SPRITESIZE - MIN_SPRITESIZE) * Rnd) + MIN_SPRITESIZE) / 100
  60.         Else
  61.             ScaleSize = gSpriteSize / 100   ' Scale ALL sprite sizes to Registry setting...
  62.         End If
  63.         ' Create new active sprite...
  64.         Set gSSprite(Idx) = ssEng.CreateSprite(Me, DeskDC, IDB_BITMAP, vbBlack, _
  65.                                            BMPXUNITS * BMPYUNITS, BMPXUNITS, BMPYUNITS, _
  66.                                            ScaleSize, ScaleSize, Idx)
  67.                                            
  68.         With gSSprite(Idx)                   ' Initialize sprite settings...
  69.             .BdrX = DispRec.Right - CLng(.uWidth * 0.8)     ' calculate width of display
  70.             .BdrY = DispRec.Bottom - CLng(.uHeight * 0.8)   ' calculate height of display
  71.             
  72.             If gSpeedRND Then               ' Determine if speed of sprite should be random
  73.                 .Dx = CLng(((20 * Rnd) + 1) * ScaleSize)    ' Randomize horizontal speed
  74.                 .Dy = CLng(((20 * Rnd) + 1) * ScaleSize)    ' Randomize verticle speed
  75.             Else
  76.                 .Dx = CLng(gSpriteSpeed * ScaleSize) + 1    ' Use speed setting from registry setting...
  77.                 .Dy = .Dx                                   ' Use speed setting from registry setting...
  78.             End If
  79.             
  80.             .x = CLng(.BdrX * Rnd) + 1      ' Randomly place sprite on x axis
  81.             .y = CLng(.BdrY * Rnd) + 1      ' Randomly place sprite on y axis
  82.             .DDx = 1                        ' (Sprite acceleration) Reserved for future use...
  83.             .DDy = 1                        ' (Sprite acceleration) Reserved for future use...
  84.             .TRACERS = gTracers             ' Set tracers option from registry setting
  85.         End With
  86.     Next
  87.     If gRefreshRND Then                     ' Set timer animation interval
  88.         ' Use random animation interval
  89.         ssTimer.Interval = CLng((MAX_REFRESHRATE - MIN_REFRESHRATE + 1) * Rnd) + MIN_REFRESHRATE
  90.     Else
  91.         ' Get animation interval from registry setting...
  92.         ssTimer.Interval = (MAX_REFRESHRATE - MIN_REFRESHRATE) + 2 - gRefreshRate
  93.     End If
  94.     ssTimer.Enabled = True                  ' Start timer (animate active sprites)
  95.     Set ssEng = Nothing                     ' Destroy sprite creation engine
  96. #If Not DebugOn Then                        ' Don't do if debugging...
  97.     If (RunMode = RM_NORMAL) Then ShowCursor 0  ' Hide MousePointer.
  98. #End If
  99. '-----------------------------------------------------------------
  100. End Sub
  101. '-----------------------------------------------------------------
  102. Private Sub Form_Click()
  103.     If (RunMode = RM_NORMAL) Then Unload Me ' Terminate if form is clicked
  104. End Sub
  105. Private Sub Form_DblClick()
  106.     If (RunMode = RM_NORMAL) Then Unload Me ' Terminate if form is double clicked
  107. End Sub
  108. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  109.     If (RunMode = RM_NORMAL) Then Unload Me ' Terminate if a key is pressed down...
  110. End Sub
  111. Private Sub Form_KeyPress(KeyAscii As Integer)
  112.     If (RunMode = RM_NORMAL) Then Unload Me ' Terminate if a key is pressed
  113. End Sub
  114. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  115.     If (RunMode = RM_NORMAL) Then Unload Me ' Terminate if form mouse is down
  116. End Sub
  117. '-----------------------------------------------------------------
  118. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  119. '-----------------------------------------------------------------
  120.     Static X0 As Integer, Y0 As Integer
  121. '-----------------------------------------------------------------
  122.     If (RunMode = RM_NORMAL) Then           ' Determine screen saver mode
  123.         If ((X0 = 0) And (Y0 = 0)) Or _
  124.            ((Abs(X0 - x) < 5) And (Abs(Y0 - y) < 5)) Then ' small mouse movement...
  125.             X0 = x                          ' Save current x coordinate
  126.             Y0 = y                          ' Save current y coordinate
  127.             Exit Sub                        ' Exit
  128.         End If
  129.         Unload Me                           ' Large mouse movement (terminate screensaver)
  130.     End If
  131. '-----------------------------------------------------------------
  132. End Sub
  133. '-----------------------------------------------------------------
  134. Private Sub Form_Paint()
  135.     PaintDeskDC DeskDC, DeskBmp, hwnd           ' Repaint desktop bitmap to form
  136. End Sub
  137. '-----------------------------------------------------------------
  138. Private Sub Form_Unload(Cancel As Integer)
  139. '-----------------------------------------------------------------
  140.     Dim Idx As Integer                          ' Array index
  141. '-----------------------------------------------------------------
  142.     ' [* YOU MUST TURN OFF THE TIMER BEFORE DESTROYING THE SPRITE OBJECT *]
  143.     ssTimer.Enabled = False                     ' [* YOU MAY DEADLOCK!!! *]
  144. '   Set gSpriteCollection = Nothing             ' Not sure if this would work...
  145.     For Idx = LBound(gSSprite) To UBound(gSSprite) ' For each active sprite...
  146.         Set gSSprite(Idx) = Nothing               ' Destroy active sprite
  147.     Next
  148. #If Not DebugOn Then                            ' Don't execute when debugging
  149.     ' Subclass windproc...(not currently used)
  150. '   SetWindowLong Me.hwnd, GWL_WNDPROC, PrevWndProc
  151. #End If
  152.     DelDeskDC DeskDC                            ' Cleanup the DeskDC (Memleak will occure if not done)
  153.     If (RunMode = RM_NORMAL) Then ShowCursor -1 ' Show MousePointer
  154.     Screen.MousePointer = vbDefault             ' Reset MousePointer
  155. '-----------------------------------------------------------------
  156. End Sub
  157. '-----------------------------------------------------------------
  158. '-----------------------------------------------------------------
  159. Private Sub ssTimer_Timer()
  160. '-----------------------------------------------------------------
  161.     Dim Idx As Integer                            ' Array index
  162. '-----------------------------------------------------------------
  163.     For Idx = LBound(gSSprite) To UBound(gSSprite)  ' For each active sprite...
  164.         gSSprite(Idx).AutoMove                      ' Automatically move active sprite
  165.     Next
  166. '-----------------------------------------------------------------
  167. End Sub
  168. '-----------------------------------------------------------------
  169.